DasyMapR - Περίπτωση χρήσης Οι αιτήσεις στο ΕΑΠ

Τσακλάνος Βαγγέλης

2016-07-16

Τι περιέχεται σε αυτό το κείμενο

Εγκατάσταση

Το πακέτο φιλοξενείται στο προσωπικό αποθετήριο του σπουδαστή στο github. Για να εγκατασταθεί το DasyMapR θα πρέπει καταρχήν να εγκατασταθεί το πακέτο devtools και στην συνέχεια με την χρήση της συνάρτησης install_github() να γίνει η εγκατάσταση του πακέτου

install.packages("devtools")
library(devtools)
install_github("etsakl/DasyMapR", build_vignettes = TRUE)
library(DasyMapR)

Περισσότερες πληροφορίες για το πακέτο θα μπορούσε να βρει κάποιος στα file του πακέτου help("DasyMapR") ή στο github

Το πακέτο DasyMapR

Το πακέτο της R που αναπτύχθηκε περιέχει μία σειρά εργαλείων που μπορούν να βοηθήσουν το χρήστη να αποδώσει τα δεδομένα στο ETRS-LAEA κάναβο αλλά και να αποσυσσωματώση δεδομένα με την χρήση βοηθιτικής επιφάνειας. Θα παρουσιαστούν κάνοντας χρήση σημειακών δεδόμενων που σχετίζονται με τις αιτήσεις που γίνονται στο ΕΑΠ με σκόπο τη συμμετοχή στις διαδικασιες επιλόγής φοιτητών του ιδρύματος. Με την χρήση των εργαλέιων που αναπτύχθηκαν αλλά και με την χρήση άλλων πακέτων της R θα γίνει προσπάθεια κατανομής των δεδομένων στο γεωγραφικό κάναβο ETRS (θα περιοριστούμε σε αυτήν την εργασία μόνο στις αιτήσεις που έγιναν απο φοιτητές που δηλώνουν κατοικία στην Ελλάδα) και στην συνέχεια θα συσχετιστουν με άλλα δεδόμενα από άλλες πηγές. Εδώ για λόγους που σχετίζονται με την προστασία των πρόσωπικών δεδόμενων των χρηστών εμφανίζεται και χρησιμοποιήται μόνο o Ταχυδρομικός Κώδικας, η χώρα και ο νομός. Εξετάζονται τα δεδομένα.

Τα δεδομένα απο το ΕΑΠ

Είναι αναμενομένο, όσες ασφαλιστικές δικλείδες και αν προβλεφθούν κατα την εισαγωγή δεδομένων απο τους χρήστες που συμπληρώνουν π.χ αιτήσεις, ότι θα υπάρξουν εγγραφές που δεν μπορούν να χρησιμοποιθουν χώρις επεξεργασία. Εν προκειμένω μία “δειγματοληπτική” προεπισκόπιση αποδεικνύει τον ισχυρισμό.

data("candidates_addresses")
candidates_addresses <- candidates_addresses[order(candidates_addresses$country), 
    ]
kable(head(candidates_addresses, 10))
country num pre street zipCode city
556 country 0 pre street zipCode city
789 country 0 pre street zipCode city
3627 country 0 pre street zipCode city
3875 country 0 pre street zipCode city
7425 country 0 pre street zipCode city
9963 country 0 pre street zipCode city
10086 country 0 pre street zipCode city
10983 country 0 pre street zipCode city
11481 country 0 pre street zipCode city
11780 country 0 pre street zipCode city
kable(candidates_addresses[round(runif(10, min = 11, max = nrow(candidates_addresses) - 
    10), 0), ])
country num pre street zipCode city
945 Ελλάδα 0 KAS ΓΡΑΜΜΟΥ 52100.0 ΚΑΣΤΟΡΙΑ
249720 Ελλάδα 0 BOI ΝΙΚΟΛΑΟΥ ΓΕΩΡΓΑΛΗ 32200.0 ΘΗΒΑ
2444 Ελλάδα 0 AXA ΑΧΕΡΟΝΤΟΣ 26442.0 ΠΑΤΡΑ
292278 Ελλάδα 0 ROD ΔΗΜΟΚΡΑΤΙΑΣ 69100.0 ΚΟΜΟΤΗΝΗ
456606 Ελλάδα 0 ATT ΡΗΓΑ ΦΕΡΑΙΟΥ 176 71 ΚΑΛΛΙΘΕΑ
122838 Ελλάδα 0 ATT ΠΑΠΑΡΡΗΓΟΠΟΥΛΟΥ 15452.0 ΑΘΗΝΑ
227877 Ελλάδα 0 AXA ΔΥ 26500.0 ΚΑΡΥΑ ΠΑΤΡΑ
513096 Ελλάδα 0 ATT ΑΡΧΑΙΑΣ ΙΛΙΔΟΣ 19007 ΜΑΡΑΘΩΝΑΣ
571243 Ελλάδα 0 ATT ΙΠΠΟΚΡΑΤΟΥΣ 14452 ΜΕΤΑΜΟΡΦΩΣΗ
525176 Ελλάδα 0 THS Ι ΤΣΕΛΕΠΗ 54352 ΘΕΣΣΑΛΟΝΙΚΗ
kable(tail(candidates_addresses, 10))
country num pre street zipCode city
139796 Τυνησία 0 NGR AMBASSADE DE GRECE RUE SAINT FULGENCE NOTREDAME 1082.0 ΤΥΝΙΔΑ
165025 Τυνησία 0 NGR AMBASSADE DE GRECE RUE SAINT FULGENCE NOTREDAME 1082.0 ΤΥΝΙΔΑ
215423 Φινλανδία 0 NGR RAJAPYYKINTIE 90650.0 OULU
372669 Φινλανδία 0 NGR UNIONINKATU 00170 HELSINKI
777881 Φινλανδία 0 NGR HAUHONTIE 00550 HELSINKI
780455 Φινλανδία 0 NGR HAUHONTIE 00550 HELSINKI
518971 ΧΑΛΑΝΔΡΙ 0
665446 ΧΑΛΑΝΔΡΙ 0
170904 Χονγκ-Κόνγκ 0 ATT ΚΩΝΣΤΑΝΤΟΠΟΥΛΟΥ 14233.0 ΑΘΗΝΑ
216045 Χονγκ-Κόνγκ 0 ATT ΑΝΤΙΓΟΝΗΣ 104-43 ΑΘΗΝΑ

Είναι πρόφανές ότι τα δεδόμενα απαιτούν προετοιμασία για να χρησιμοποιηθούν. Η προετοιμάσία των δεδομένων παρατίθεται στο τέλος του κειμένου όπου υπάρχει ο κώδικας και παρουσίαση των βοηθιτικών δεδομένων που θα χρησιμοποιθουν για να πετύχουμε την γεωναφοα τους. Όπως παρατηρείται τα δεδομένα εχουν διορθωθεί για τις εγγραφές “pre” (~νομός) και τις χώρες προέλευσης (country). Γενικά ο νομός ως γεωγραφική αναφορά εμφανίζει λιγότερες λανθασμένες εγγραφές αφού οι χρήστες σε γενικές γραμμές γνωρίζουν τον νόμο που διαμένουν όχι όμως απαραίτητα και τον Ταχυδρομικό Κώδικα της διευθυνσης που δηλώνουν. Λιγότερο αξιοπιστη είναι αναφορά στην οδό όπου η ονοματοδοσία και η αριθμοδοσία (όταν ή αν) γίνεται απο τους οργανισμούς της Τοπικης Αυτοιδιοικισης με χρονική και τοπική διασπόρα. Αποτελέσμα είναι να μην μπορούν να θεωρήθουν αξιόπιστα δεδομένα ακόμη και όταν συμπληρώνονται σωστά απο τον χρήστη.

Δασυμετρική Χαρτογράφια στα δεδομένα του ΕΑΠ.

Μετά την επεξεργασία των δεδομένων, που όπως προαναφέρθηκε ο τρόπος αναλύεται στο τέλος του κειμένου, ανακτούμε τα δεδομένα που συνοδέυουν το πακέτο και αφορούν τις αιτήσεις στο ΕΑΠ. Οι αιτήσεις έχουν ομαδοποιησθεί ανά χωρική περιοχή αναφοράς. Ας οπτικοποιησουμε κατα αρχήν τα δεδομένα όπως αρχικά xορηγήθηκαν με ένα απλό χωροπληθή χάρτη 5 τάξεων.

To “σφάλμα” της απεικόνισης

Αναναπαριστούμε τον αριθμό των αιτήσεων στα όρια του νομού γενικευοντας σε διαστήματα τόσα ώστε οι αποχρώσεις να διακρίνονται απο το χρήστης. Αυτός ο χάρτης όμως δημιουργεί εσφαλμένη εντύπωση στο χρήστη για 2 κυρίως λόγους. Καταρχήν σε καθε νομό φαίνεται ομοιογενής ο αριθμός των αιτουντων. Έτσι τα Κύθηρα φαίνεται να ανήκουν στην ίδια κατηγορία με την Αθήνα δηλαδή έχοντας αριθμό αιτήσεων μεταξύ 11000 και 350000. Το ίδιο βέβαια μπορεί να προκαλλέσει και η επιλογή της διαίρεσης σε 5 διαστήματα τιμών. Το πρώτο σφάλμα “οφείλεται”" στην “επιλόγή” της μονάδας απαρίθμισης (περίπου όρια νομού) και αυτό θα “διορθωθεί” με την χρήση των εργαλέιων που αναπτύχθηκαν.

data("EAP.application.pre_err")
dasymapPlot.leaflet(EAP.application.pre_err, 5)

Με βάση τους διορθωμένους Ταχυδρόμικούς Κώδικές είναι δυνατό να δημίουργήσουμε μια “ρεαλιστικότερη” εικόνα για τις περιοχές που έγιναν οι αιτήσεις στο ΕΑΠ. Εδώ θα χρησιμοπoιήσουμε την πληροφορία του Ταχυδρομικού Κώδικα που μας επιτρεπει να έχουμε αναφορά των αιτούντων στα όρια του προ καποδιστριακού Δήμου. Αυτή η “ρεαλιστικότερη” απεικόνιση όπου η επιλογή της μονάδα απαρίθμισης (τώρα τα όρια του δήμου) έχει βελτιώση την απεικόνιση των δεδομένων. θα μπορούσε μάλιστα να συγκριθεί με το αποτέλεσμα της δασυμετρικής χαρτογραφίας που θα εφαρμόζουμε στην συνέχεια.

data("EAP.application.loc")
dasymapPlot.leaflet(EAP.application.loc, 2)

Ήδη αυτή η εικόνα δίνει άλλη αντίληψη για την διασπορά των υποψηφίων στην επικράτεια απ’ ότι ο προηγούμενος. Για παράδειγμα τα Κύθηρα δεν ανήκουν στις περιοχές με το υψηλότερο αριθμό δηλώσεων. Έχουμε το μεγαλύτερο αριθμό αιτήσεων στου Δήμους Αστικά κέντρα κ.λ.π. Όμως και εδώ υπάρχουν σφάλματα λόγω των διοκιτκών ορίων. Π.χ Μικροί Δήμοι εξυπηρετούνται απο το Ταχυδρομικό γραφείο της περιοχής του μεγαλύτερου Δήμου. Έτσι εμφανίζονται και πάλι με πλασματικό αριθμό αιτούνταων λόγω της επιλογής της επιφάνειας απρίθμησης.
Αν θέλαμε όμως να απεικονισουμε την κατανομή σε μεγαλύτερη κλίμακα όπου δεν υπάρχουν δεδομένα απαρίθμισης ή τα στοιχεία έχουν συσωματωθεί και αποκρίπτεται η εν λόγω πληροφορία τότε θα επρεπε να χρησιμοποiηsουμε κάποια άλλη μέθοδο. Εδώ προτείνεται η μέθοδος της δασυμετρικής χαρτογραφία και το λογισμικό που αναπτύχθηκε στην R (DasyMapR) για να κάνει αυτή την εργασία.

Ας δούμε τώρα μία απεικόνιση του φαινομένου ‘αιτήσεις ΕΑΠ’ σε πιό μεγάλη κλίμακα. Επλεγεται η Αττική και αποδίδεται πλέον με χάρτη κουκίδων. Κάθε κουκιδα αντιστοιχούν 10 αίτησεις και τοποθετέιται τυχαία στο πολύγωνο του νομού. Ας αντληφθούμε την διαδικασία σαν προπσάθεια να τοποθετήσουμε την κουκίδα στην (όσο το δυνατόν) πραγματική της θέση. Αυτό θα γίνει με την προβολή της επιφάνειας πηγής στον κάναβο την χρήση βοηθιτικής επιφάνειας και τέλος την εφαρμογή δασυμετρικών υπολογισμών

# Φορτώνουμε τα όρια NUTS. Χρησιμοποείται η EtrsTransform του Πακέτου
# DasyMapR για την αλλαγή του συστήματος συντεταγμεων στο επιθυμητό ETRS.
NUTS_2013_01M_EL_ETRS <- EtrsTransform(NUTS_2013_01M_EL)
# Μας ενδιαφέρπυν οι περιφεριακές ενότητες(νομοι)
NUTS_2013_01M_EL_ETRS <- NUTS_2013_01M_EL_ETRS[grep("^EL\\d{3}", NUTS_2013_01M_EL_ETRS[["NUTS_ID"]]), 
    ]
count.EAP.applicants <- as.data.frame(table(candidates_addresses_el_cor["NUTS_313"], 
    dnn = "NUTS_ID"), stringAsFactor = F)
EAP.application.NUTS <- merge(x = NUTS_2013_01M_EL_ETRS, y = count.EAP.applicants, 
    by = "NUTS_ID")
# H χρήση της merge ενδεχομένως να προκαλέσει αλλαγή στα rownames του
# dataframe οπότε έστω και προληπτικά τα διορθώνουμε
row.names(EAP.application.NUTS@data) <- sapply(slot(EAP.application.NUTS, "polygons"), 
    function(x) slot(x, "ID"))
# Διαλέγουμε περιοχή
EAP.application.NUTS.30 <- EAP.application.NUTS[grep("^EL30[1-6]", EAP.application.NUTS[["NUTS_ID"]]), 
    ]
applicants <- EAP.application.NUTS.30@data$Freq/10
plot(EAP.application.NUTS.30)
for (i in 1:length(EAP.application.NUTS.30)) {
    EAP.application.NUTS.30.pl <- SpatialPolygons(EAP.application.NUTS.30@polygons)
    points(spsample(EAP.application.NUTS.30.pl[i], applicants[i], "regular"), 
        pch = 1, cex = 0.2, col = 2)
}
title(main = "Χάρτης αιτήσεων στο ΕΑΠ", sub = "Περιφέρεια Αττικής")

kable(head(EAP.application.NUTS.30@data[, c(1, 5)]), col.names = c("NUTS_ID", 
    "Αιτήσεις"))
NUTS_ID Αιτήσεις
745 EL301 65139
746 EL302 41825
747 EL303 118679
748 EL304 52190
749 EL305 29602
750 EL306 6331

Χρήση του LAEA καναβου με δεδομένα απο την απο την Eurostat (resolution 1km)

Θα κανουμε αρχικά χρήση δεδομένων του ESPOΝ ως βοηθιτικής επιφάνειας δηλαδή το κάναβο LAEA με βοηθητκή επιφανεια τον πλυθισμό του 2011 όπως έχει κατανεμηθεί ο πλυθησμος της απογραφής του 2011 με αρκετά περίπλοκους αλγορίθμους.

Θα ανάγουμε καταρχήν τις αιτησεις σε αριθμό αιτήσεων αν 1000 κατοίκους κάνοντας χρήση δεδομένων της EUROSTAT

Μεταφορτώνουμε τα δεδομένα

# O παρακάτω κώδικας δεν τρέχει πάντα γιατί εξαρτάται απο την σύνδεση
# nama_10r_3popgdp <- get_eurostat(id = 'nama_10r_3popgdp' ,filters =
# list(time=2013),time_format = 'num')
POP_EL <- nama_10r_3popgdp[grep("^EL\\d{3}", nama_10r_3popgdp$geo), ]
kable(head(POP_EL))
unit geo time values
670 THS EL301 2009 616
671 THS EL302 2009 512
672 THS EL303 2009 1097
673 THS EL304 2009 555
674 THS EL305 2009 504
675 THS EL306 2009 167
POP_EL.30 <- nama_10r_3popgdp[grep("^EL30[1-6]", nama_10r_3popgdp$geo), ]

και κάνουμε τους υπολογισμούς

EAP.application.NUTS@data$POP <- unlist(sapply(EAP.application.NUTS$NUTS_ID, 
    FUN = function(x) POP_EL$values[match(x, POP_EL$geo)]))
EAP.application.NUTS[["appPerhab"]] <- round(EAP.application.NUTS@data$Freq/EAP.application.NUTS@data$POP, 
    0)
kable(head(EAP.application.NUTS))
NUTS_ID STAT_LEVL_ SHAPE_AREA SHAPE_LEN Freq POP appPerhab
667 EL522 3 0.3924027 4.937318 93328 1136 82
668 EL523 3 0.2700854 3.152490 3252 81 40
669 EL524 3 0.2679729 3.318840 6994 142 49
670 EL525 3 0.1616531 2.621749 7195 127 57
671 EL631 3 0.5604019 6.666641 10719 215 50
672 EL632 3 0.3360470 3.150293 33266 316 105

Ας δούμε και παλί τα αποτελέσματα στο χάρτη.

dasymapPlot.leaflet(EAP.application.NUTS, 7)

Θα μετατρέψουμε την στατιστική επιφάνεια “αιτήσεις ανά 1000 κατοίκους” σε κάναβο με την χρήση της etrsSurfacePar που αναπτύχθηκε και περιέχεται στο πακέτο (μέθοδος που κάνει διάχυτο υπολογισμο) που επιτάχύνει πολύ τους υπολογισμούς. Θα περιοσριστούμε στην Αττική για οικονομία χρόνου και χόρου

EAP.application.NUTS.30 <- EAP.application.NUTS[grep("^EL30[1-6]", EAP.application.NUTS[["NUTS_ID"]]), 
    ]
EAP.application.NUTS.grid.30 <- etrsSurfacePar(EAP.application.NUTS.30, over.method.type = "MaxArea", 
    cell.size = 1000)
## ~~~ ETRS validity ~~~

Χρησημοποιουμε την joinMaxAreaSurfaceDataFrames, επίσης μέθοδος του πακέτου, για ενημερώσουμε την επιφάνεια που δημιουργήσαμε με τα atrributes της επιφανειας πηγής.

EAP.application.NUTS.grid.30 <- joinMaxAreaSurfaceDataFrames(the.surface = EAP.application.NUTS.30, 
    the.EtrsSurface = EAP.application.NUTS.grid.30)

Και τελικά ας δουμε την επιφάνεια πηγή που παραχθηκε με την βοήθεια της συνάρτησης dasymaplot του πακέτου που παράγει χωροπληθής χάρτες 5 τάξεων.

# EAP.application.NUTS.grid.30<-EAP.application.NUTS.grid[grep('^EL30[1-6]',EAP.application.NUTS.grid[['NUTS_ID']]),]
dasymapPlot.leaflet(EAP.application.NUTS.grid.30, 11)
kable(head(EAP.application.NUTS.grid.30))
FEATURE CELLCODE EASTOFORIGIN NORTHOFORIGIN NUTS_ID STAT_LEVL_ SHAPE_AREA SHAPE_LEN Freq POP appPerhab
1kmE5536N1765 745 1kmE5536N1765 5536000 1765000 EL301 3 0.0136015 0.7073062 65139 616 106
1kmE5534N1766 745 1kmE5534N1766 5534000 1766000 EL301 3 0.0136015 0.7073062 65139 616 106
1kmE5535N1766 745 1kmE5535N1766 5535000 1766000 EL301 3 0.0136015 0.7073062 65139 616 106
1kmE5536N1766 745 1kmE5536N1766 5536000 1766000 EL301 3 0.0136015 0.7073062 65139 616 106
1kmE5531N1767 745 1kmE5531N1767 5531000 1767000 EL301 3 0.0136015 0.7073062 65139 616 106
1kmE5533N1767 745 1kmE5533N1767 5533000 1767000 EL301 3 0.0136015 0.7073062 65139 616 106

Ας δουμε τώρα αν μπορούμε να χρησιμοποιήσουμε δεδομένα από τις UMZ200 που ειδικά για το πληθυσμό προσφέρονται δεδομένα στον ETRS-LAEA κάναβο για τα έτη 2006 2011 που έχουν προκύψει από την

kable(head(GEOSTAT_grid_POP_1K_2011_V2_0_el))
TOT_P GRD_ID CNTR_CODE METHD_CL YEAR DATA_SRC TOT_P_CON_DT
1059777 4 1kmN1910E5127 EL M 2011 EL 0
1059778 108 1kmN1911E5127 EL M 2011 EL 0
1059779 30 1kmN1910E5128 EL M 2011 EL 0
1059780 250 1kmN1911E5128 EL M 2011 EL 0
1059781 41 1kmN1917E5141 EL M 2011 EL 0
1059782 19 1kmN1918E5141 EL M 2011 EL 0

Μία πιο προσεκτική ματιά σε αυτά τα δεδομένα δείχνει δεν ακολουθούν την προτεινόμενη κωδικοποίηση των κελιών της INSPIRE Specification on Geographical Grid Systems Θα γίνει χρήση της μέθοδου etrsReverseCellCode του πακέτου DasyMapR. Τέλος Η απλή συγχωνευση μας δίνει ένα καναβο με τις δυο τιμές που ενδιαφέρουν δηλάδη του των αριθμό των κατοίκων ανα κελι και τον αριθμό των κατοίκων ανά 1000 κατοίκους.

GEO_POP_2011_rev <- etrsReverseCellCode(df = GEOSTAT_grid_POP_1K_2011_V2_0_el, 
    cell.code.col = 2)
GEO_POP_2011_rev <- GEO_POP_2011_rev[, c(1, 8)]

EAP.application.NUTS.grid.30 <- merge(EAP.application.NUTS.grid.30, by = 0, 
    GEO_POP_2011_rev, all = F)
row.names(EAP.application.NUTS.grid.30@data) <- sapply(slot(EAP.application.NUTS.grid.30, 
    "polygons"), function(x) slot(x, "ID"))

EAP.application.NUTS.grid.30@data$applicants <- round((EAP.application.NUTS.grid.30@data$appPerhab * 
    EAP.application.NUTS.grid.30@data$TOT_P)/1000, 0)

Ας δούμε και παλί την κατανομή σε ενα χάρτη με τους αiτούντες ανά κελί

dasymapPlot.leaflet(EAP.application.NUTS.grid.30, 15)

Μερικά “εύκολα” συμπεράσματα

Ήδη είναι κατανητό ότι η κατανομή αυτή είναι ήδη πιο κοντά στην πραγματικότητα. Π.χ. Δεν εμφανίζονται πλέον αιτούντες στην Πάρνηθα!

Δασυμετρικοί υπολογισμοί (resolution 500m)

Οι υπολογισμοί που ακολουθουν θα γίνουν με τις αμειγώς δασυμετρικές μεθόδους που αναπτυχθηκαν διμηουργώντας και την επιφάνεια πηγή. Αρχικά θα κάνουμε χρηση των δεδομένων CORINE που αφορουν την καλύψη. Ξεκινάμε παλι με την προετοιμασία της επιφάνειας πηγής. Αυτή τη φορά θα εργαστούμε σε μιτκρότερη περιοχή. Θεψρούμε ο βόρειος τομέας είναι κατάλληλος

Η Επιφάνεια Πηγή

Ο αριθμός των αιτούντων ανά νομό θα προβλήθεί στον ETRS κάναβο διμιουργώντας την επιφάνεια πηγή. Αρχικά θα Θα πρέπει να μετατραπεί από απόλυτη τιμή σε πυκνότητα αιτούντων. Στο πακέτο έχει αναπτυχθεί η μέθοδος :DasyMapR::ActullVal2Density που θα κάνει την μετατροπή

EAP.application.NUTS.301 <- EAP.application.NUTS[grep("^EL30[123]", EAP.application.NUTS[["NUTS_ID"]]), 
    ]
# Διαιρούμε με το εμβαδό της νεάς μονάδας απαρίθμισης
EAP.application.NUTS.301 <- ActuallVal2Density(EAP.application.NUTS.301, surface.value.col = 5, 
    area.unit = 1e+06)
EAP.source.surface <- etrsSourceSurface(input.surface = EAP.application.NUTS.301, 
    over.method.type = "PropCal", surface.value.col = 7, cell.size = 500)
## ~~~ ETRS validity ~~~
## ~~~ ETRS validity ~~~
## ~~~ ETRS validity ~~~
## ~~~ ETRS validity ~~~
dasymapPlot(EAP.source.surface, 4)

kable(head(EAP.source.surface@data))
CELLCODE EASTOFORIGIN NORTHOFORIGIN CELLVALUE
500mE55310N17575 500mE55310N17575 5531000 1757500 0.2916
500mE55305N17580 500mE55305N17580 5530500 1758000 1.6416
500mE55310N17580 500mE55310N17580 5531000 1758000 97.3512
500mE55315N17580 500mE55315N17580 5531500 1758000 77.0904
500mE55320N17580 500mE55320N17580 5532000 1758000 51.7752
500mE55325N17580 500mE55325N17580 5532500 1758000 26.4492

Η κατανομή που έγινε στα κελλιά του κανάβου περίπου ισο κατενειμαι τον αριθμό των αιτήσεων με εξαίρεση τα οριακά κελλιά. Ας το δούμε στο χάρτη που ακολουθεί. Θα χρειαστούμε κάποια βοηθιτικά δεδομένα για να επιτύχουμε την ρεαλιστικότερη κατανομή των αιτούντων στο χώρο. Είναι απολύτως λογικό να θεωρήσουμε ότι οι ταχυδρομικοί κώδικες αντιστοιχούν σε κατοικημένες περιοχές. Αυτή έιναι και η βοηθητική επιφάνεια που θα χρσηιμοποισουμε. δηλaδή τις κατοικοιμένες περιοχές όπως δίνονται απο τα αρχεία το πρόγραμμα CORINE

Η βοηθιτική Επιφάνεια

Για να διμιουργήσουμε την βοηθιτκή επιφάνεια θα χρησιμοποιησουμε την συναρτηση etrsAncillarySurface μεθόδο που έχει αναπτυχθεί και περιλλαμβανεται στο πακέτο DasyMapR και θα φορτωθουν τα δεδομένα που περιεχονται στο πακέτο.

residential.areas <- clc_v2_code_11x_el[EAP.application.NUTS.301, ]
# residential.areas<-residential.areas[-10,]
bound301 = list(EAP.application.NUTS.301, border = 2, lwd = 2)
bound = list(EAP.application.NUTS)
spplot(residential.areas, "code_00", main = "Περιοχές Κατοικίας  CORINE", 
    sp.layout = list(bound, bound301), col.regions = c("yellow", "blue"))

Θα αποδώσουμε και σχετικές πυκνότητες για τις περιοχές κάνοντας την παραδοχή ότι στις πυκνοδομημενες περιοχές (111 - Συνεχής αστική οικοδόμηση) θα έχουμε περισσότερες κατοικίες απο ότι στις πιο αραιοκατοικιμένες (112 - Διακεκομμένη αστική οικοδόμηση)

ReDens111 <- round(3/4, 2)
ReDens112 <- round(1/4, 2)
residential.areas@data[which(residential.areas@data[, "code_00"] == 111), "ReDens"] <- ReDens111
residential.areas@data[which(residential.areas@data[, "code_00"] == 112), "ReDens"] <- ReDens112
residential.areas.anc <- etrsAncillarySurface(input.surface = residential.areas, 
    over.method.type = "PropCal", surface.value.col = 2, cell.size = 500, binary = F)
## ~~~ ETRS validity ~~~
## ~~~ ETRS validity ~~~
## ~~~ ETRS validity ~~~
spplot(residential.areas.anc, "WCELLWEIGHT", main = "Περιοχές Κατοικίας  Βοηθητική Επιφάνεια / grided", 
    sp.layout = list(bound, bound301), edge.col = "lightgrey")

Οι Δασυμετρικοί Υπολογισμοί

H μέθοδος για την εφαρμογή των δασυμετρικών υπολογισμών που θα κλιθεί είναι etsrDasymetricSurface και θα έχει ως ορίσματα την επιφάνεια πηγή και την βοηθιτική επίφανεια.

EAP.dasymetric.surface <- EtrsDasymetricSurface(input.surface.grided = EAP.source.surface, 
    ancillary.grided = residential.areas.anc)
## ~~~ ETRS validity ~~~
EAP.dasymetric.surface[["DASYCELL"]] <- round(EAP.dasymetric.surface[["DASYCELL"]], 
    0)

Ας εξετάσουμε τα αποτελέσματα των υπολογισμών μας και την νέα μας κατανομή για τις αιτήσεις των υποψηφίων στο ΕΑΠ.

dasymapPlot(EAP.dasymetric.surface, 6)
title(main = "Χάρτης αιτήσεων στο ΕΑΠ", sub = "Δασυμeτρική επιφάνεια")
plot(pc_regions[EAP.application.NUTS, ], border = "1", add = T, lty = 3)
kable(head(EAP.dasymetric.surface@data[, c(1, 6)]), col.names = c("Κωδικός Κελλιου", 
    "Αιτήσεις"))
Κωδικός Κελλιου Αιτήσεις
429 500mE55310N17575 0
396 500mE55305N17580 2
430 500mE55310N17580 95
465 500mE55315N17580 75
504 500mE55320N17580 49
544 500mE55325N17580 3

Είναι αναμένομενο τα αστικά κέντρα να έχουν μεγαλύτερο αριθμό αιτήσεων απο τους οικισμούς οι τις αγροτικές περιοχές και αυτό αποτυπώνεται στο χάρτη. Aς δούμε ττώρα σε ενα διαδρραστικό χάρτη πως έγινε η κατανομή

dasymapPlot.leaflet(EAP.dasymetric.surface, 6)

Μια συντομη περιήγηση διαπιστώνεται ότι αυτή η κατανομή των αιτήσεων δεν είναι ακριβεστερη της προηγούμενης όμως είναι δυνατόν με κατάλλλη επιλογή συντλεστών μπορέι να γίνει ακριβέστερη. Για αυτό θα μπορουσε να χρησιμοποειθεί η μέθοδος ‘etrsProWeightedValue’ που συνοδευει το πακετο.

Προετοιμασία των Δεδομένων

Αναζητούνατι οι αιτήσεις που έχουν γίνει απο την Ελλάδα

candidates_addresses_el <- candidates_addresses[candidates_addresses$country %in% 
    "Ελλάδα", ]
kable(head(candidates_addresses_el, 10))

Εχει γίνει ήδη αντιλληπτό ότι οι ταχυδρομικοί κώδικες είτε δεν έχουν συμπληρωθεί απο τους χρήστες σωστά είτε δεν έχουν το σωστό φορμά ή τύπο. “Διορθώνουμε” τους ταχυδρομικούς κώδικες με το παρακάτω κώδικα. Δεν αναφέρoνται λεπτομέρεις για το τί κάνει ο κώδικας γιατί ο καθασρισμός των δεδομένων δεν είναι το κύρίως αντικείμενο που παρουσίαζεται στο κείμενο.

candidates_addresses_el$zipCode <- as.character(candidates_addresses_el$zipCode)
# αφαιρούνται σημεία στίξης αλλά και κενά απο ΤΚ
candidates_addresses_el$zipCode <- gsub("[[:space:]]", "", candidates_addresses_el$zipCode)
candidates_addresses_el$zipCode <- gsub("[[:punct:]]", "", candidates_addresses_el$zipCode)
# γράφουμε τοκ κωδικό σε μορφή Τ.Κ.
candidates_addresses_el$POSTCODE <- paste0(substring(candidates_addresses_el$zipCode, 
    1, 3), " ", substring(candidates_addresses_el$zipCode, 4, 5))
# Και αναζητούμε όσους δεν εχουν τιμή η έχουν τιμή που δεν είναι Τ.Κ
check_pc <- !(grepl("[[:digit:]]{3}[[:space:]][[:digit:]]{2}$", candidates_addresses_el$POSTCODE, 
    perl = T))
# Τι δεδομένα είναι αυτά? εξηγείται παρακάτω
data("pc_regions")
# απόδοση τιμών ΤΚ από τον πίνακα pc_regions με βάση την πολή
candidates_addresses_el_np <- subset(candidates_addresses_el, check_pc)
candidates_addresses_el_wp <- subset(candidates_addresses_el, !check_pc)
candidates_addresses_el_np$POSTCODE <- unlist(sapply(candidates_addresses_el_np$city, 
    FUN = function(x) as.character(pc_regions@data$POSTCODE[match(x, pc_regions$EDRA)])))
candidates_addresses_el <- rbind(candidates_addresses_el_wp, candidates_addresses_el_np)
# Και αναζητούμε όσους δεν εχουν τιμή η έχουν τιμή που δεν είναι Τ.Κ
check_pc <- (grepl("[[:digit:]]{3}[[:space:]][[:digit:]]{2}$", candidates_addresses_el$POSTCODE, 
    perl = T))
candidates_addresses_el <- subset(candidates_addresses_el, check_pc)
# Υπάρχουν Τ.Κ. θυρήδων Αθήνων οπότε αποδίδονται στην Αθήνα
check_pc <- grepl("[1]{1}[0]{1}[0-4]{1}[[:space:]][0-3]{1}[0]{1}", candidates_addresses_el$POSTCODE, 
    perl = T)
candidates_addresses_el[check_pc, "POSTCODE"] <- "104 31"
# Υπάρχουν Κωδικοί εξωτερικού ή που δεν μπορούν να συσχετιστουν
check_pc <- grepl("^[8-9]{1}[6-9]{1}[0-4]{1}[[:space:]][0-9]{1}[0-9]{1}", candidates_addresses_el$POSTCODE, 
    perl = T)
candidates_addresses_el_np <- subset(candidates_addresses_el, check_pc)
candidates_addresses_el_wp <- subset(candidates_addresses_el, !check_pc)
candidates_addresses_el_np$POSTCODE <- unlist(sapply(candidates_addresses_el_np$city, 
    FUN = function(x) as.character(pc_regions@data$POSTCODE[match(x, pc_regions$EDRA)])))
candidates_addresses_el <- rbind(candidates_addresses_el_wp, candidates_addresses_el_np)
check_pc <- grepl("^[8-9]{1}[6-9]{1}[0-4]{1}[[:space:]][0-9]{1}[0-9]{1}", candidates_addresses_el$POSTCODE, 
    perl = T)
candidates_addresses_el <- subset(candidates_addresses_el, !check_pc)
# Υπαρχουν κωδικοί που εμφανίζονται λίγες φορές με έλεγχο κρίθηκε ότι δεν
# αντιστοιχούνσε ΤΚ και αποδίδονται στα 3 πρώτα ψηφία
cnt_py <- count(candidates_addresses_el, vars = c("POSTCODE"))
cnt_py_lf <- subset(cnt_py, cnt_py$freq <= 20L)
cnt_py_hf <- subset(cnt_py, cnt_py$freq > 20L)
check_pc <- !is.na(match(candidates_addresses_el$POSTCODE, cnt_py_lf$POSTCODE))
candidates_addresses_el_wp <- subset(candidates_addresses_el, !check_pc)
candidates_addresses_el_np <- subset(candidates_addresses_el, check_pc)
candidates_addresses_el_np$POSTCODE <- unlist(sapply(candidates_addresses_el_np$POSTCODE, 
    FUN = function(x) as.character(pc_regions@data$POSTCODE[match(substring(x, 
        first = 1, last = 3), substring(pc_regions$POSTCODE, first = 1, last = 3))])))

candidates_addresses_el_cor <- rbind(na.exclude(candidates_addresses_el_np), 
    candidates_addresses_el_wp)

# Προσθέτω τυχαίες χρονιές αιτήσεων για χρήση ως παράδειγμα
year <- round(runif(nrow(candidates_addresses_el_cor), min = 1998, max = 2016), 
    0)
candidates_addresses_el_cor["YEAR"] <- year

kable(head(candidates_addresses_el, 10))

Επίσης δεν θα γίνει ανάλυση στο συγκεριμένο κείμενο για τους ταχυδρομικούς κώδικές και πως σχετίζονται με τον γεωγραφικό χώρο. Εδώ χρησιμοποιούνται παρεμπιπτοντως ως στοιχείο που διατίθεται για την γεωναφορά των αιτήσεων. Απλώς αναφέρεται ότι Οι ταχυδρομικοί κωδικοί είναι διαχωρισμένοι σε :

Πληροφορίες μπορούν εύκολα να βρεθούν στο διαδύκτιο π.χ. Κατάλογος ταχυδρομικών κωδικών της Ελλάδας.

Με βάση δεδομένα που μπορούν να βρεθούν στο διαδίκτυο αποδόθηκαν, στα πολυγωνα των προ “Καποδιστρικών Δήμων” μιά σειρά κωδικών που εμφανίζονται σε πίνακες με στατιστικά δεδομένα και μπορούν να βοηθήσουν στην συσχέτιση των κελλιών κανάβου με περιγραφικά δεδομένα. Τα δεδομένα αυτά περιλαμβάνονται στο πακέτο και ήδη εγινε χρήση τους για να συμπληρωθούν τιμές απο εγγραφές που δεν υπήρχαν στα αρχικά δεδομένα. Λεπτομέρειες για την απόδοση τιμών στα πολυγωνα αναφερόνται στο τέλος του κειμένου όπου εξηγείται και η μέθοδος DasyMapR::pntsattr2surface που ανατπύχθηκε για να αποδίδει κατηγορικές τιμές από σημειακά δεδομένα σε επιφάνειες

Εδώ εμφανίζονται ενα απόσπασμα των περιγραφικών δεδομένων

kable(head(pc_regions[, 1:12]))
kable(head(pc_regions[, 13:24]))

Αυτοί οι κωδικοι μπορούν να αποδωθούν στα κελλιά για συσχετισης με δεδομένα απο πλήθος πήγων (ΕΣΥΕ,EUROSTAT κ.λ.π) Ας δούμε τώρα τα πολύγωνα με τα όρια των ΟΤΑ (πριν τη διοικιτική μεταρύθμιση “Καποδίστριας”)

plot(pc_regions)

Γυρίζωντας στις αιτήσεις των υπόψήφιων του ΕΑΠ και για να τις απεικονήσουμε στις γεωγραφικές θέσεις που αντιστοιχούν θα συσχετίσουμε την συχνότητα εμφάνισης με το πολύγωνο του ταχυδρομικού κώδικα που αντιστοιχέι

kable(head(candidates_addresses_el, 10))

Τα δεδομένα που περιέχονται pc_regions δεν μπορούν να χρησιμοποιηθουν όπως είναι, γιατί σε αρκετές περιπωσεις περιέχονται “διπλοεγγραφές”. Π.Χ. είναι δυνατόν δυό περισσότερες περιοχές να εουν τον ίδιο Τ.Κ. Ή ένας νομός να έχει περίσσοτερους του ενός κωδικούς NUTS. (παλιό και καινούργιο)

data("pc_regions")

#'ΝΟΜΟΙ ΑΠΟ ΤΟ raw ΑΡΧΕΙΟ'
# #Διόρθωοη των 'νομών'
cnt_py_pre_err <- as.data.frame(table(candidates_addresses["pre"]))
colnames(cnt_py_pre) <- c("POSTCODE", "Freq")
# Αφαίρεση εγγραφών και απόδοση κωδικών
cnt_py_pre_err <- read.csv("cnt_py_pre_err.csv", sep = ",")
# Συσωμάτωση με το νομό ΙΙ
pc_regions_data <- pc_regions@data
pc_regions_data <- pc_regions_data[, c("PREF_ID", "PREFECTURE")]
pc_regions_data <- unique(pc_regions_data)
rownames(pc_regions_data) <- pc_regions_data$PREF_ID
pc_regions_sp <- unionSpatialPolygons(pc_regions, pc_regions@data$PREF_ID)
pc_regions_pref <- SpatialPolygonsDataFrame(pc_regions_sp, pc_regions_data)
# #Γεωαναφορά
EAP.application.pre_err <- merge(x = pc_regions_pref, y = cnt_py_pre_err, by = "PREF_ID")
EAP.application.pre_err@data[is.na(EAP.application.pre_err$Freq), "Freq"] <- 0L


# Συσσωμάτωση με βάση το ΤΚ
pc_regions_data <- pc_regions@data
pc_regions_data <- unique(pc_regions_data["POSTCODE"])
rownames(pc_regions_data) <- pc_regions_data$POSTCODE
pc_regions_sp <- unionSpatialPolygons(pc_regions, pc_regions@data$POSTCODE)
pc_regions_ag <- SpatialPolygonsDataFrame(pc_regions_sp, pc_regions_data)
# Γεωαναφορά
cnt_py_loc <- as.data.frame(table(candidates_addresses_el_cor["POSTCODE"]))
EAP.application.loc <- merge(x = pc_regions_ag, y = cnt_py_loc, by = "POSTCODE")
EAP.application.loc@data[is.na(EAP.application.loc$freq), "freq"] <- 0L

# Συσωμάτωση με το νομό ΙΙ
pc_regions_data <- pc_regions@data
pc_regions_data <- pc_regions_data[, c("PREF_ID", "PREFECTURE")]
pc_regions_data <- unique(pc_regions_data)
rownames(pc_regions_data) <- pc_regions_data$PREF_ID
pc_regions_sp <- unionSpatialPolygons(pc_regions, pc_regions@data$PREF_ID)
pc_regions_pref <- SpatialPolygonsDataFrame(pc_regions_sp, pc_regions_data)
# Γεωναφορά
EAP.application.pre <- merge(x = pc_regions_pref, y = cnt_py_pre_err, by = "PREF_ID")
EAP.application.pre@data[is.na(EAP.application.pre_err$Freq), "Freq"] <- 0L

#'ΝΟΜΟΙ ΑΠΟ ΤΟ raw ΑΡΧΕΙΟ' NUTS
EAP_NUTS_V9 <- read.csv("EAP_NUTS_V9.csv")
# Γεωαναφορά
GR <- NUTSV9_LEAC[which(!is.na(match(NUTSV9_LEAC[["N0CD"]], "GR"))), ]
EAP.NUTS <- merge(x = NUTSV9_LEAC, y = EAP_NUTS_V9, by.x = "N3CD", by.y = "NUTS_V9", 
    all.y = TRUE)
EAP.NUTS <- EAP.NUTS[which(!is.na(EAP.NUTS@data$PREF_ID)), ]

plot(perf)
applicants <- perf@data$freq
points(spsample(x = perf, n = applicants, type = "random"), pch = 1, cex = 0.5, 
    col = 2)
# Χρήση των pc_el_NUTS20xx
candidates_addresses_el_cor$NUTS_310 <- unlist(sapply(candidates_addresses_el_cor$POSTCODE, 
    FUN = function(x) as.character(pc_el_NUTS2010$NUTS_3[match(x, pc_el_NUTS2010$POSTCODE)])))

candidates_addresses_el_cor$NUTS_313 <- unlist(sapply(candidates_addresses_el_cor$POSTCODE, 
    FUN = function(x) as.character(pc_el_NUTS2013$NUTS_3[match(x, pc_el_NUTS2013$POSTCODE)])))

candidates_addresses_el_cor$NUTS_309 <- unlist(sapply(candidates_addresses_el_cor$pre, 
    FUN = function(x) as.character(EAP_NUTS_V9$NUTS_V9[match(x, EAP_NUTS_V9$pre)])))

candidates_addresses_el_cor$PREF_ID <- unlist(sapply(candidates_addresses_el_cor$POSTCODE, 
    FUN = function(x) as.character(pc_regions$PREF_ID[match(x, pc_regions$POSTCODE)])))